perm filename ELISP.LSP[MAC,LSP] blob
sn#679553 filedate 1982-10-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 MacLisp portion of the E/MacLisp Interface.
C00021 00003 Routines to queue up mail
C00024 00004 αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
C00027 00005 Mail Interface
C00028 00006 Interrupt Defer
C00029 00007 Mail Type
C00033 00008 Wait Mail
C00037 00009 Mask Routines
C00039 00010 Mail SFA
C00042 00011 Tyi
C00045 00012 Tyo
C00048 00013 Force Output
C00051 00014 Message Align
C00054 00015 Mail Refresh
C00055 00016 Transfer Buffer
C00061 00017 Clear Input
C00062 00018 Wait OK
C00065 00019 Send Simple Message
C00067 00020 Em:init
C00070 00021 Send OK
C00071 00022 Em:eval-protect
C00072 00023 Mail queue
C00076 00024 Readonly Variables
C00082 00025 Random debugging stuff
C00085 00026 Storage for Mail routines
C00090 ENDMK
C⊗;
;;; MacLisp portion of the E/MacLisp Interface.
;;;
;;; An SFA/MAIL based system for communicating with
;;; an unstructured, standard text editor.
;;; Starts with si:ejobnum figured out from E.
;;; (sfa-call <sfa> 'send-lines n)
;;; sets the number of lines that are sent at one time to n.
;;; normal is T (meaning send every line).
;;; NIL means never send.
;;; (sfa-call <sfa> 'report-send-lines) returns the value
;;; si:ecalledp, the global variable, tells whether E called you
;;; GABRIEL 7/1/82 3:42
;;; lqp has been simplified. Tyi-inited, and mailinp have been eliminated.
;;; The latter have been replaced by INBYTES and RINBYTES, which are now
;;; better kept up to date. INBYTES = 0 and RINBYTES = 1 are now the
;;; defaults for mail (readonlymail) not ready to ildb
;;; Some E type stuff moved to EAID. ADD-QUEUE now will reset the interface if
;;; there is not enough core for the arrays.
;;; *History*
(declare (mapex t)
; (setq defmacro-for-compiling ())
(special -em:ecommands- -em:sfa- -em:errorp-
-em:oldtyi- -em:oldtyo- -em:mode- -em:silence-
-em:mail-input-buffer-dry-handler- -em:queue- -em:lqueue-
-em:herald- -em:cmchar-table- -em:si:ecalledp- si:ejobnum
si:sail-mail-service -em:within-add-queue-
-em:filemode- -em:linel-)
(*expr em:get-next-readonly em:force-readonly-message em:make-sixbit
em:readonly-init em:warn em:message-align em:send-simple-message
em:crlf-message-align
em:mail-sfa em:init-send-lines em:init em:get-jobnum em:set-jobnum
em:turn-mask-off em:business-address em:mail-interrupt-handler
em:message-type em:mask-on em:eval-protect em:mask-off em:copy-alias1)
(*lexpr em:fread %match)
(fixnum si:ejobnum))
(eval-when (compile) (terpri msgfiles)
(princ "CHNINT & INTPDL need to be defined!" msgfiles)
(terpri msgfiles))
(setq -em:ecommands- ()
-em:mail-input-buffer-dry-handler- ()
-em:within-add-queue- ()
-em:mode- 'LTYPE
-em:si:ecalledp- ()
-em:oldtyi- tyi -em:oldtyo- tyo
-em:filemode- ()
-em:cmchar-table- ()
-em:herald- '|MacLisp Ready|
-em:silence- ()
-em:linel- (linel t))
(defun em:mail-interface-initialize ()
(em:turn-mask-off)
(setq -em:queue- ())
(setq -em:lqueue- ())
(em:initialize)
(setq -em:si:ecalledp- t)
(and -em:herald-
(progn (princ -em:herald-)(terpri)))
(sfa-call -em:sfa- 'force-output ())
(setq si:sail-mail-service 'em:mail-interrupt-handler)
)
(setq -em:sfa- ())
(sstatus ttyint 200. '+internal-↑b-break)
(sstatus ttyint 232. '+internal-↑b-break)
(sstatus ttyint 206. 'em:reset&↑b-break)
(sstatus ttyint 238. 'em:reset&↑b-break)
(defun em:reset&↑b-break (()())
(em:reset)
(+internal-↑b-break () ()))
(defun em:copy-alias ()
(apply `crunit `(dsk ,(em:copy-alias1))))
(defun em:initialize ()
(em:get-jobnum)
(em:init)
(em:copy-alias)
(em:init-send-lines)
(setq -em:sfa- (sfa-create (function em:mail-sfa) 0 'mail-sfa))
(setq tyi -em:sfa-)
(setq tyo -em:sfa-)
(setq msgfiles `(,-em:sfa-))
(sfa-store -em:sfa- 'xcons -em:sfa-)
(em:send-simple-message 'ok)
)
(defun em:connect (n)
(em:set-jobnum n)
(em:init)
(em:init-send-lines)
(setq -em:sfa- (sfa-create (function em:mail-sfa) 0 'mail-sfa))
(setq tyi -em:sfa-)
(setq tyo -em:sfa-)
(setq msgfiles `(,-em:sfa-))
(sfa-store -em:sfa- 'xcons -em:sfa-)
(em:send-simple-message 'ok)
)
(defmacro unascii (x)
`(car (exploden ,x)))
(defun em:naecommands (l)
(em:ecommands (append '(α - α x M A L T M O D E ⊗ ↔) L)))
(defun em:ecommands (l)
(sfa-call -em:sfa- 'force-output ())
(let ((-em:ecommands- t))
(do ((com l (cdr com)))
((null com)(sfa-call -em:sfa- 'force-output ()))
(cond ((eq (car com) '<cr>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o27))
((eq (car com) '<lf>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o1))
((eq (car com) '<sp>)
(sfa-call -em:sfa- 'tyo '32.))
((eq (car com) '<bs>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o102))
((eq (car com) '<tab>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o75))
((eq (car com) '<⊗>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o26))
((eq (car com) '<alt>)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o33))
(t
(sfa-call -em:sfa- 'tyo
(unascii (car com))))))))
;;; Like above, but takes ascii codes
(defun em:raw-ecommands (l)
(sfa-call -em:sfa- 'force-output ())
(let ((-em:ecommands- t))
(do ((com l (cdr com)))
((null com)(sfa-call -em:sfa- 'force-output ()))
(cond ((= (car com) #o11)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o75))
((= (car com) #o175)
(sfa-call -em:sfa- 'tyo #o26)
(sfa-call -em:sfa- 'tyo #o33))
(t
(sfa-call -em:sfa- 'tyo
(cond ((= (car com) #o15) #o26)
((= (car com) #o12) #o27)
(t (car com)))))))))
(defun em:set-send-lines (n)
(sfa-call -em:sfa- 'send-lines n))
(defun em:get-send-lines ()
(sfa-call -em:sfa- 'report-send-lines ()))
(defun em:force ()
(sfa-call -em:sfa- 'force-output ()))
;(setq read-eval-print-* 'em:terpri)
(defun em:terpri () (terpri -em:sfa-))
(defun em:real-terpri () (tyo #o40 -em:sfa-)(terpri -em:sfa-))
(defun em:eval-message ()
((lambda (eof)
(em:message-align)(em:set-send-lines t)
(do ((form (em:fread eof) (em:fread eof))
(l nil))
((eq form eof)
(do ((i (nreverse l) (cdr i)))
((null i)
(sfa-call -em:sfa- 'force-output ())
(em:set-send-lines ()))
(print (car i))))
(setq l (cons (eval form) l)))) (ncons ())))
(defun em:eval-message-warn ()
((lambda (eof)
(em:message-align)(em:set-send-lines t)
(do ((form (em:fread eof) (em:fread eof))
(l nil))
((eq form eof)
(em:warn '|Done!|)
(do ((i (nreverse l) (cdr i)))
((null i)
(sfa-call -em:sfa- 'force-output ())
(em:set-send-lines ()))
(print (car i))))
(setq l (cons (eval form) l)))) (ncons ())))
(defmacro em:read-until-eof (form return . forms)
`((lambda (eof)
(em:message-align)
(do ((,form (em:fread eof) (em:fread eof)))
((eq ,form eof) ,return)
. ,forms)) (ncons ())))
(defmacro em:tyi-until-eof (form return . forms)
`((lambda (-em:filemode-)
(em:message-align)
(do ((,form (tyi -em:sfa- -1) (tyi -em:sfa- -1)))
((= ,form -1) ,return)
. ,forms)) t))
(defun em:tyi-message ()
(let ((ans ()))
(em:tyi-until-eof form (nreverse ans)
(push form ans))))
(defun em:tyi-line ()
(let ((ans ()))
(em:ecommands '(α =))
(em:tyi-until-eof form (nreverse ans)
(push form ans))))
(defun em:fread n
((lambda (-em:filemode-)
(cond ((zerop n)
(read))
((= n 1)
(read (arg 1)))
((= n 2)
(read (arg 1)(arg 2)))
(t
(break |too many args to FREAD| t))))
t))
(defun em:control-dispatch (char)
(cond ((member char '(#o302 #o342))
(funcall '+internal-↑B-break -em:sfa- char))
((member char '(#o307 #o347))
(em:init)
(↑G))
((member char '(#o303 #o343))
(setq ↑D ()))
((member char '(#o304 #o344))
(setq ↑D t))
((member char '(#o322 #o362))
(em:init)(↑G))
((member char '(#o316 #o356))
(em:reset)(+internal-↑B-break ()()))
(t ((lambda (fun)
(cond (fun (funcall fun -em:sfa- char))
((setq fun (cdr (assoc char
-em:cmchar-table-)))
(funcall fun char) char)))
;(t (+internal-↑B-break () ())))) ;foo we are SUNK!!!
(status ttyint char)))))
(defun em:readonly-vars (l)
;make up message and initial (sixbit . ascii) alist
(em:readonly-init)
(cond ((> (length l) 25.)
(do ((rest l (cdr rest))
(i 25. (1- i))
(first25 ()))
((= i 0)
(append
(em:readonly-vars first25)
(em:readonly-vars rest)))
(push (car l) first25)))
(t
(setq l
(mapcar #'(lambda (x)
(subst () ()
`(,(em:make-sixbit x)
,x () ())))
l))
(em:force-readonly-message)
(do ((nxt (em:get-next-readonly)
(em:get-next-readonly))
(entry))
((equal nxt -1)
(mapcan #'(lambda (x)
(cond
((caddr x)
`((,(cadr x) . ,(cadddr x))))))
l))
(cond ((setq entry (assoc (car nxt) l))
(rplaca (cdddr entry) (cdr nxt))
(rplaca (cddr entry) t)))))))
(defun em:add-cmfun (char fun)
(push `(,char . ,fun) -em:cmchar-table-))
(defun em:delete-cmfun (char)
(setq -em:cmchar-table-
(mapcan
#'(lambda (x)
(cond ((= char (car x)) ())
(t (ncons x))))
-em:cmchar-table-)))
(defun em:ttyint (l)
(let ((entry (assoc (car l) -em:cmchar-table-)))
(cond ((cadr l)
(cond (entry (rplacd entry (cadr l))
(cadr l))
(t (em:add-cmfun (car l)(cadr l)))))
(t (cdr entry)))))
(defun em:transcript-read n
((lambda (form)
(print form)
form)
(apply 'read (listify n))))
(defun em:transcript-off (() ()) (em:transcript ()))
(defun em:transcript (flag)
(cond (flag (setq read 'em:transcript-read)
(em:ecommands '(α X L F I L E ⊗ ↔ α X E V A L ⊗ ↔ ))
(setq -em:mode- 'LFILE)
(em:swallow-alt)
'TRANSCRIPT)
(t (em:ecommands '(α X l t y p e ⊗ ↔))
(setq -em:mode- 'LTYPE)
(setq read ()))))
(defun em:swallow-alt ()
(do ((i (tyi)(tyi)))
((= i #o175) t)))
(defun em:mode (mode) (setq -em:mode- mode))
(defun em:lfile-mode () (setq -em:mode- 'lfile)
(em:ecommands
'(α X L F I L E ⊗ ↔ α X S A Y | | L F I L E | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:ltype-mode () (setq -em:mode- 'ltype)
(em:ecommands
'(α X L T Y P E ⊗ ↔ α X S A Y | | L T Y P E | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:lattach-mode () (setq -em:mode- 'lattach)
(em:ecommands
'(α X L A T T A C H ⊗ ↔ α X S A Y | | L A T T A C H | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:lpend-mode () (setq -em:mode- 'lfile)
(em:ecommands
'(α X L P E N D ⊗ ↔ α X S A Y | | L P E N D | | /m /o /d /e ⊗ ↔))
(setq -em:silence- t))
(defun em:readonly-var (var)
(cdr (assq var (em:readonly-vars `(,var)))))
(defun em:reset ()
(setq -em:sfa- ())
(setq tyi -em:oldtyi-)
(setq tyo -em:oldtyo-)
(setq msgfiles ())
(setq si:ecalledp ()))
(defun em:fail-act (x)
(cond ((and -em:within-add-queue-
(not (atom x))
(eq (car x) '*array))
(em:warn '|No core for message queueing - resetting!| )
(em:init)
(↑g))
(t (+internal-fac-break x))))
(setq fail-act 'em:fail-act)
(defun em:read () (read -em:sfa-))
(defun em:send-current ()
(em:ecommands '(α =))
(read -em:sfa-))
;;; Routines to queue up mail
;;; The queue is an ALIST of array, business address pairs
(defun em:add-queue ()
(let ((-em:within-add-queue- t))
(let ((ar (*array () 'fixnum 32.)))
(setq -em:queue-
(nconc -em:queue- `(,ar )))
(em:business-address (maknum ar)))))
(defun em:get-queue ()
(cond (-em:queue-
(prog2 ()
(em:business-address
(maknum (car -em:queue-)))
(setq -em:queue- (cdr -em:queue-))))))
(defun em:get-lqueue ()
(cond (-em:lqueue-
(prog2 ()
(em:business-address
(maknum (car -em:lqueue-)))
(setq -em:lqueue- (cdr -em:lqueue-))))))
(defun em:add-lqueue (n)
(let ((-em:within-add-queue- t))
(let ((ar (*array () 'fixnum (+ 1 n))))
(setq -em:lqueue-
(nconc -em:lqueue- `(,ar )))
(em:business-address (maknum ar)))))
(defun em:remove-tail ()
(cond (-em:queue-
(cond ((cdr -em:queue-)
(do ((l -em:queue- (cdr l))
(x (cdr -em:queue-) (cdr x)))
((null x)
(rplacd l ()))))
(t (setq -em:queue- ()))))))
(defun em:get-readonly-queue ()
(cond (-em:queue-
(cond ((eq 'readonly
(em:message-type (maknum (car -em:queue-))))
(prog1 (car -em:queue-)
(setq -em:queue- (cdr -em:queue-))))
(t (do ((l (cdr -em:queue-) (cdr l))
(x (cddr -em:queue-) (cdr x)))
((null l) ())
(cond ((eq 'readonly (em:message-type (maknum (car l))))
(prog1 (car l)
(rplacd l x))))))))))
;;; αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
;;; αnαxSLISP talks to job n(10.)
;;; α0αxSLISP types the wholine of inferior
;;; α-αxSLISP murder (i.e. negotiated suicide)
;;; α= send arrow line or attach buffer
;;; α+nα= send next n lines
;;; α-nα= send previous n lines
;;; αx= <sexp>
;;; send comand line
;;;
;;; Protocols: (* means not actually anticipated to be used; current
;;; implementation knows about it but does not send and/or interpret them
;;; specially)
;;;
;;; From E to MacLisp
;;; Mail
;;; wd0: Job# sending message
;;; wd1: type of message
;;;
;;; 2,,0: Continuation needed
;;; 1,,0: Short (fits in the next =30 words, ends with null byte
;;; or falls off)
;;;
;;; 0 no-op
;;; 1 initiating a conversation
;;; 2 ok (did the jobread)
;;; 3 SEXPs
;;; 4 explicit eof
;;; 5 control (meta) chars to follow (E macro format)
;;; (or E commands (from MacLisp to E))
;;; 6 interrupt. do <esc>i <char>
;;; 7 close connection (suicide)
;;; 8 readonly variables
;;;
;;; wd2: -number of bytes,,address of buffer
;;;
;;;
;;; E commands will be represented in the standard E macro manner
;;; (unless there is something better).
;;;
;;;
;;; Protocol is:
;;; E MacLisp
;;; ---------------
;;; initiate
;;; ok
;;;
;;; To send a short message just a MAIL
;;; To send a long message MAIL then wait for JOBREAD acknowledge
;;; To send interrupts, just send them
;;; Acknowledgment is the short OK message
;;;
;;; Commands needed:
;;; start DMP file
;;; send control chars
;;; send interrupt character (just 1 at a time)
;;;
;;; Mail Interface
(defun em:mail-interface (jobnum)
(setf (jobnum job) jobnum)
(setq si:ejobnum jobnum))
;;; Interrupt Defer
;;; Takes a char in TT and defers the interrupt
(defun em:defer-interrupt ()
<pushes interrupt info on the Lisp interrupt stack>)
;;; Mail Type
(defun em:process-mail (message)
(setf (explicit-eofp message) ())
(setf (forcedp message) ())
(cond ((continuation message)
(setq continuation t)))
(caseq (type message)
(e-command 'e-command)
(no-op 'no-op)
(sexps
(cond ((shortp message)
(fill-buffer
(length message)
(content message)))
(t (transfer-buffer)))
'sexps)
(readonlyvars
(cond ((shortp message)
(fill-readonly-buffer
(length message)
(contents message)))
(t (transfer-readonly-buffer)))
'readonlyvars)
(interrupt
(em:control-dispatch (contents message)))
(explicit-eof
(setf (explicit-eofp message) t)
'eof)
(ok 'ok)
(kill
(exit))
(t (error (type message) "Unknow Message Type"))))
;;; Wait Mail
(defun em:wait-mail (type)
(cond (tyop (force2)))
(cond (-em:queue-
(cond ((eq type 'readonlyvars)
(em:get-readonly-queue))
(t (em:get-queue))))
(t (cond (-em:mail-input-buffer-dry-handler-
(em:call-handler)))
(do ((message (wrcv) (wrcv)))
((em:validate-message message)
message)))))
(defun em:validate-message (message)
(and (eq (validation message) "EPR")
(= (jobnum message) si:jobnum)))
;;; Mask Routines
(defun em:mask-off () <mask off interrupts>)
(defun em:mask-on () <mask on interrupts>)
;;; Mail SFA
(defun em:mail-sfa (object type x)
(caseq type
(which-operations
'(tyi tyo force-output untyi charpos linel
force-readonly-message send-lines report-send-lines
ttyint))
(tyi (em:mail-tyi))
(tyo (em:mail-tyo))
(force-output
(em:mail-force-output))
(untyi
(em:mail-untyi))
(charpos
(em:mail-charpos x))
(linel
(em:mail-linel x))
(send-lines
(em:send-lines))
(report-send-lines
(em:report-send-lines))
(force-readonly-message
(em:force-readonly-message))
(ttyint
(em:ttyint1))
(t ())))
(defun em:mail-charpos (x)
(cond (x (setq em:charpos x))
(t em:charpos)))
(defun em:mail-linel (x)
(cond (x (setq em:mail-linel x))
(t em:mail-linel)))
(defun em:send-lines (x)
(setq em:send-lines x)
(setq em:skipp x)
t)
(defun em:report-send-lines ()
em:send-lines)
(defun em:init-send-lines ()
<initialize WRCV system>
(setq em:skipp ()
em:send-lines ()))
;;; Tyi
(entry em:mail-tyi subr)
em:mail-tyi
(skipe 0 explicit-eof)
(jrst 0 eeof)
(movem c eofchar)
(skipe 0 untyif)
(jrst 0 untyi2)
; (skipn 0 tyi-inited) ;not inited?
; (pushj p real-mail-refresh)
ityi (skipe 0 inbytes) ;and nothing left?
(jrst 0 tyi1)
(skipe 0 (special -em:filemode-)) ;in special file mode?
(jrst 0 reof)
tyi2 (pushj p mail-refresh)
tyi1 (aosle 0 inbytes)
(pushj p mail-refresh)
inmailok
(setzm 0 newwrcv)
(ildb tt inpoint) ;get byte
(trne tt cntrl-bit)
(jrst 0 pondercntrl)
(jrst 0 fix1) ;what a bum!
em:mail-untyi
(aos 0 untyif)
(move b untyipdl)
(push b c)
(movem b untyipdl)
(popj p)
untyi2 (move b untyipdl)
(sosl 0 untyif)
(pop b a)
(movem b untyipdl)
(popj p)
eeof (setzm 0 explicit-eof)
reof
(move a eofchar)
(sub p (% 0 0 1 1))
(popj p)
pondercntrl
(trnn tt meta-bit) ;foo it was control-meta
(jrst 0 tyi3)
(jrst 0 fix1) ;what a bum!
tyi3 (caie tt ccntrlg) ;↑G
(cain tt cntrlg) ;↑g
(jrst 0 ↑Ghandler)
(caie tt ccntrlx) ;↑X
(cain tt cntrlx) ;↑x
(jrst 0 ↑Xhandler)
(movei tt 0 tt)
(jsp t fxcons)
(jcall 1 'em:control-dispatch)
(popj p)
↑Xhandler
(movei t em:mail-tyi)
(push p t)
(push p (% 0 0 'quit))
(movni t 1)
(jcall 16 'error)
↑Ghandler
(pushj p em:init)
(call 0 '↑G)
(entry em:messagep subr)
; (skipe 0 tyi-inited)
(skipge 0 inbytes)
(jrst 0 true)
(skipe 0 (special -em:queue-))
(jrst 0 true)
(mail 3)
(jrst 0 false)
(jrst 0 true)
;;; Tyo
(entry em:mail-tyo subr)
em:mail-tyo
(skipe 0 (special ↑W))
(popj p)
(setzm 0 forcedp)
(setom 0 tyop)
(move a @ c)
(caie a cr)
(cain a lf)
(skipa)
(setom 0 noncrlf) ;means a non crlf char has been sent
tyo1 (pushj p ucharpos) ;update charpos
(idpb a outpoint) ;put it there
(sosg 0 outbytes) ;ready to send?
(pushj p cmail-sendit)
(caie a lf)
(jrst 0 linelforce)
forceit
(skipn 0 noncrlf)
(jrst 0 true) ;only crlf's so far
(skipn 0 send-lines) ;if T then just return
(jrst 0 fmail-sendit)
(movei tt 't)
(camn tt send-lines)
(jrst 0 true)
(sosle 0 skipp) ;ready to do it?
(jrst 0 true)
(jrst 0 fmail-sendit)
;;; special entry for Refresh case only
force2 (skipe 0 send-lines) ;if T then just return
(popj p)
(jrst 0 fmail-sendit)
ucharpos
(caie a cr) ;cr
(jrst 0 uchrp1)
(setzm 0 charpos)
(popj p)
uchrp1 (cain a bs)
(jrst 0 adjstbs)
(cain a tab) ;tab
(jrst 0 adjstab)
(aos 0 charpos)
(popj p)
adjstab (move tt charpos)
(idivi tt 8.)
(aos 0 tt)
(imuli tt 8.)
(movem tt charpos)
(popj p)
adjstbs (aos 0 charpos)
(popj p)
linelforce
(caie a #o40) ;space?
(cain a #o11) ;tab?
(skipa)
(jrst 0 true)
(move tt charpos)
(camg tt @ (special -em:linel-))
(jrst 0 true)
(movei a #o15)
(pushj p ucharpos) ;update charpos
(idpb a outpoint) ;put it there
(sosg 0 outbytes) ;ready to send?
(pushj p cmail-sendit)
(movei a #o12)
(jrst 0 tyo1)
;;; Force Output
fmail-sendit
(setom 0 forcedp)
(setz b)
(jrst 0 mail-sendit)
cmail-sendit
(movei b cont-bit)
(jrst 0 mail-sendit)
em:mail-force-output
(entry em:mail-force-output subr)
(skipe 0 forcedp)
(jrst 0 true)
(setz b) ;continuation
mail-sendit
(aos 0 critical)
(722←33 0 mailint) ;imskcl
(setzm 0 noncrlf)
(setzm 0 charpos)
(setzm 0 tyop)
(move a vsend-lines)
(movem a skipp)
(setz t)
(skipe 0 (special -em:silence-))
(jrst 0 skipit)
(hrlzi a omailbox)
(hrri a (+ omailbox 1))
(setzm 0 omailbox)
(blt a (+ omailbox (- mlblksize 1))) ;zero it
(movei a noutbytes)
(sub a outbytes)
(movei t 1) ;1 in t means long
(caile a maxshort) ;short enough
(jrst 0 send-message) ;nope
(setz t) ;0 in T means short
(hrlzi tt outmail)
(hrri tt (+ omailbox 3))
(blt tt (+ omailbox (- mlblksize 1))) ;move to the right place
(iori b short-bit)
send-message
(hrl tt b) ;swap
(hrri tt sexp-type)
(skipe 0 (special -em:ecommands-))
(hrri tt ecommand-type)
(movem tt (+ omailbox 1))
(movns 0 a)
(hrlzm a (+ omailbox 2))
(movei a outmail)
(hrrm a (+ omailbox 2))
(move a thisjob)
(hrli a epr) ;epr validation
(movem a omailbox)
(movem t sav)
(mail 3) ;shit, mail arrived and it might be long!
(mail 5 ojobnum) ;mail it
(jsp tt wait-for-clear)
(move t sav)
skipit (setzm 0 (special -em:silence-))
(move a outpointtem) ;setup output byte count
(movem a outpoint)
(movei a noutbytes)
(movem a outbytes)
(jumpe t sm2) ;don't hang around
(pushj p wait-ok) ;wait for acknowledgment
sm2 (hrlzi a outmail)
(hrri a (+ outmail 1))
(setzm 0 outmail)
(blt a (+ outmail (- rdblk 1))) ;zero it
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(jrst 0 true)
;;; Message Align
;;; Gets to the beginning of the next message
(entry em:message-align subr)
(args em:message-align (nil . 0))
em:message-align
(skipe 0 newwrcv)
(jrst 0 true)
(pushj p mail-refresh)
(jrst 0 true)
;;; The following has been flushed:
;;; -----------------------------------------------------------
;;; Routine to get to a buffer from E with not all <cr>s in it
;(entry em:crlf-message-align subr)
;(args em:crlf-message-align (nil . 0))
;em:crlf-message-align
;
; (skipe 0 newwrcv)
; (jrst 0 true)
; (move tt inpoint) ;copy of byte pointer
; (move t inbytes)
; (skipe 0 untyif) ;stuff on the untyi stack?
; (jrst 0 filalun) ;foo, there is.
;filalgn2
; (aosle 0 t)
; (jrst 0 filalgn1)
; (setzm 0 newwrcv)
; (ildb a tt)
; (skipn 0 a)
; (jrst 0 alnxtx)
; (caie a tab)
; (cain a space)
; (jrst 0 alnxtx)
; (caie a cr) ;a cr?
; (cain a lf) ;a lf?
; (skipa)
; (jrst 0 true)
;
;alnxtx (ibp 0 inpoint)
; (aos 0 inbytes)
; (jrst 0 filalgn2)
;filalgn1
; (pushj p mail-refresh)
; (jrst 0 true)
;
;filalun (move r untyipdl)
; (move f untyif)
;filalu1 (sosge 0 f)
; (jrst 0 filalgn2)
; (pop r a)
; (move a 0 a)
; (caie a tab)
; (cain a space)
; (jrst 0 filxtx)
; (caie a cr) ;a cr?
; (cain a lf) ;a lf?
; (skipa)
; (jrst 0 true)
;
;filxtx (movem r untyipdl)
; (movem f untyif)
; (jrst 0 filalu1)
;;; Mail Refresh
;;; This routine gets fresh mail to initialize the reader
mail-refresh
real-mail-refresh
(aos 0 critical)
(722←33 0 mailint) ;imskcl
mr2
mr3 (pushj p em:wait-mail) ;wait for response
(pushj p em:process-mail) ;get the mail
(caie a 'sexps)
(jrst 0 mr3)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(popj p)
;;; Transfer Buffer
;;; This routine does a jobread into the right spot.
;(entry tb subr)
transfer-buffer
(skipe 0 lqp) ;queued mail read already?
(jrst 0 tb1)
(skipe 0 (special -em:queue-))
(jrst 0 queue-stuff)
; (setom 0 tyi-inited) ;ready to read
(move a transfer-spot)
(hrrzm a (+ jobread 2))
(pushj p zinmail)
(move a (+ imailbox 2))
(hrl a inwords)
(movem a (+ jobread 1))
(movei tt jobread)
(calli tt 400050) ;jobrd
(jrst 0 fjobrd)
(aos 0 critical)
(722←33 0 mailint) ;imskcl
(pushj p send-ok)
(setzm 0 lqp)
(skipe 0 contp)
(jrst 0 queue-stuff2)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(popj p)
tb1 (setzm 0 lqp)
(popj p)
transfer-short
(pushj p zinmail)
(hrlzi a (+ imailbox 3)) ;move from here
(hrr a transfer-spot) ;to here
(move tt transfer-spot)
(addi tt (- mlblksize 1))
(blt a 0 tt) ;transfer 29
; (setom 0 tyi-inited) ;ready to read
; (setzm 0 lqp)
(popj p)
zinmail
(hrlz a transfer-spot)
(move tt transfer-spot)
(aos 0 tt)
(hrr a tt)
(setzm 0 @ transfer-spot)
(move tt transfer-spot)
(add tt transfer-size)
(blt a -1 tt)
(popj p)
;(entry qs subr)
queue-stuff
(aos 0 critical)
(722←33 0 mailint) ;imskcl
queue-stuff2
(push fxp tt)
(movem freeac (+ svdacs 9.))
(movei freeac svdacs)
(hrli freeac b)
(blt freeac (+ svdacs 9.))
(setz b)
(movei freeac c)
(hrli freeac b)
(blt freeac freeac)
zt4
(call 0 'em:add-queue)
(hrrz tt 0 a) ;address of mailbox
; (skipn 0 mailinp) ;already wrcv'd it?
; (jrst 0 zt5)
; (movei tt imailbox)
; (jrst 0 zt9)
zt5
(mail 1 0 tt) ;get mail
zt9 (push fxp tt)
(move tt 0 tt)
(jsp t validate-mail)
(jrst 0 zt6)
(pop fxp tt)
(move t 1 tt) ;type bits
(cain t interrupt-type) ;can have no long type
(jrst 0 punt1)
(cain t kill-type) ;can have no long type
(calli 1 12) ;kill self
(push fxp t)
(movei t 0 t) ;foo, what if it's long!
(caie t sexp-type)
(jrst 0 zt0)
(move t 0 fxp)
; (setzm 0 lqp)
(tlnn t short-bit) ;short?
(pushj p enqueue-buffer)
(pop fxp t)
(setzm 0 contp)
(tlze t cont-bit)
(jrst 0 zt7)
; (setom 0 lqp)
(jrst 0 zt8)
zt6 (pop fxp tt)
(jrst 0 zt5)
zt7 (setom 0 contp)
(movem t 1 tt)
(jrst 0 zt4)
zt0 (pop fxp t)
zt8 (hrlzi freeac svdacs)
(hrri freeac b)
(blt freeac freeac)
(pop fxp tt)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(popj p)
;(entry eb subr)
enqueue-buffer
(push fxp tt)
(hrrz tt 0 fxp)
(move a 2 tt) ;address in E of buffer
(hrrzm a (+ ljobread 1))
(hlre tt a) ;-number of bytes
(idivi tt 4) ;-number of words
(jumpe d zt1)
(subi tt 1) ;one more, bunkie
zt1
(hrlm tt (+ ljobread 1))
(movns 0 tt)
(jsp t fxcons)
(call 1 'em:add-lqueue)
(hrrz a 0 a) ;address of mailbox
(hlre tt (+ ljobread 1))
(movem tt 0 a)
(aos 0 a)
(hrrzm a (+ ljobread 2))
(movei tt ljobread)
(calli tt 400050) ;jobrd
(jrst 0 pfxpfalse)
(pop fxp tt)
(jrst 0 send-ok)
punt1 (setzm 0 1 tt)
(move d t)
(add fxp (% 0 0 4 4)) ;adjust stack in obscure manner
(pushj p procint)
(mail 3)
(skipa)
(jrst 0 zt4)
(pop fxp tt)
(jrst 0 zt8)
;;; Clear Input
(entry em:clear-input subr)
(args em:clear-input (nil . 0))
(setzm 0 lqp)
(setzm 0 critical)
(setzm 0 tyop)
(setzm 0 forcedp)
(setzm 0 noncrlf)
(setzm 0 untyif)
(setzm 0 inbytes)
(movei a 1)
(movem 1 rinbytes)
(move a temuntyipdl)
(movem a untyipdl)
(setom 0 explicit-eof)
; (setzm 0 mailinp)
; (setzm 0 tyi-inited)
(pushj p zinmail)
(movei a 't)
(popj p)
;;; Wait OK
;(entry wait-ok subr)
wait-ok
(aos 0 critical)
(722←33 0 mailint) ;imskcl
wo2 (mail 1 imailbox) ;WRCV
(move tt (+ imailbox 1))
(hrrzs 0 tt) ;flush short?
(caie tt ok-type)
(jrst 0 wo1)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(jrst 0 true)
wo1
(push fxp tt)
(movem freeac (+ svdacs 9.))
(movei freeac svdacs)
(hrli freeac b)
(blt freeac (+ svdacs 9.))
(setz b)
(movei freeac c)
(hrli freeac b)
(blt freeac freeac)
(call 0 'em:add-queue)
(move a 0 a)
(move tt a)
(hrli a imailbox)
(move b tt)
(addi b (- mlblksize 1))
(blt a 0 b)
(jrst 0 zt19)
zt14 (call 0 'em:add-queue)
(hrrz tt 0 a) ;address of mailbox
zt15 ;(mail 2 0 tt) ;mail here so soon?
(mail 1 0 tt) ;get mail
(push fxp tt)
(move tt 0 tt)
(jsp t validate-mail)
(jrst 0 zt16)
(pop fxp tt)
zt19 (move t 1 tt) ;type bits
(cain t interrupt-type)
(jrst 0 punt2)
(cain t kill-type)
(calli 1 12)
(push fxp t)
(movei t 0 t)
(caie t sexp-type)
(jrst 0 zt00)
(move t 0 fxp)
; (setzm 0 lqp)
(tlnn t short-bit) ;short?
(pushj p enqueue-buffer)
(pop fxp t)
(setzm 0 contp)
(tlze t cont-bit)
(jrst 0 zt17)
; (setom 0 lqp)
(jrst 0 zt14)
zt16 (pop fxp tt)
(jrst 0 zt14)
zt17 (setom 0 contp)
(movem t 1 tt)
(jrst 0 zt14)
zt00 (pop fxp t)
zt18 (hrlzi freeac svdacs)
(hrri freeac b)
(blt freeac freeac)
(pop fxp tt)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(jrst 0 true)
punt2 (setzm 0 1 tt)
(move d t)
(add fxp (% 0 0 4 4)) ;adjust stack in obscure manner
(pushj p procint)
(mail 3)
(skipa)
(jrst 0 zt14)
(pop fxp tt)
(jrst 0 zt18)
;;; Send Simple Message
(entry em:send-simple-message subr)
(args em:send-simple-message (nil . 1))
(cain a 'ok)
(jrst 0 ok-message)
(cain a 'initiate)
(jrst 0 initiate-message)
(cain a 'hold-it)
(jrst 0 hold-it-message)
(cain a 'eof)
(jrst 0 eof-message)
(movei a 'Invalid-message)
(popj p)
eof-message
(movei a explicit-eof-type)
(jrst 0 send-simple-message)
initiate-message
(movei a initiate-type)
(jrst 0 send-simple-message)
ok-message
(movei a ok-type)
(jrst 0 send-simple-message)
hold-it-message
(movei a 102)
(movem a (+ omailbox 2))
(movei a interrupt-type)
send-simple-message
(movem a (+ omailbox 1))
(move b thisjob)
(hrli b epr)
(movem b omailbox)
(jfcl)
(mail 5 ojobnum)
(jsp tt wait-for-clear)
(jrst 0 true)
(jrst 0 false)
; (entry wfc subr)
wait-for-clear
(mail 3)
(jrst 0 wfc1) ;nothing there?
(aos 0 critical)
(722←33 0 mailint)
(pushj p queue-stuff2)
wfc1 (setz a)
(calli a 31)
(jrst 0 -3 tt)
gobble-stuff
(mail 3)
(popj p) ;nothing there?
(aos 0 critical)
(722←33 0 mailint)
(pushj p queue-stuff2)
gbst1 (setz a)
(calli a 31)
(jrst 0 gobble-stuff)
;;; Em:init
(entry em:init subr)
(args em:init (nil . 0))
em:init
(movei a '(features paging))
(call 17 'status)
(jumpe a in1)
(movei a #o65126)
(movem a chnint)
(movei a #o2201)
(movem a intpdl)
(jrst 0 in2)
in1 (movei a #o456006)
(movem a chnint)
(movei a @ #o125)
(hrrz a 0 a)
(movem a intpdl)
in2 (setzm 0 (special -em:queue-))
(setzm 0 (special -em:lqueue-))
(setzm 0 inbytes)
(setzm 0 tyop)
(movei a 1)
(movem a rinbytes)
(setzm 0 lqp)
(setzm 0 newwrcv)
(setzm 0 critical)
(setzm 0 withinrov)
(setzm 0 delayedsexp)
(movei tt inmail)
(movem tt transfer-spot)
(movei tt blksize)
(movem tt transfer-size)
(movei tt noutbytes)
(movem tt outbytes)
(movei tt nrovbytes)
(movem tt rovbytes)
(move tt inpointtem)
(movem tt inpoint)
(move tt outpointtem)
(movem tt outpoint)
(pushj p zinmail)
(calli tt #o30)
(movem tt thisjob)
(jrst 0 fix1)
em:get-terminal
(movei tt #o236)
(calli tt #o33) ;jobtlin
(add tt ijobnum) ;add jobnum
(calli tt #o33) ;get terminal line number
(hrrzm tt termlin) ;save it
(popj p)
(entry em:warn subr)
(args em:warn (nil . 1))
(call 1 'exploden)
(movei tt 500.)
(move t mpointtem)
(move a 0 a)
wloop (hlrz b a)
(move b 0 b)
(idpb b t)
(sosge 0 tt)
(jrst 0 wdone)
(skipn 0 b)
(jrst 0 wdone)
(move a 0 a)
(jrst 0 wloop)
wdone
(movei a dmess)
sendmess
(move tt termlin)
(calli tt #o400111) ;beep it
(movem a (+ termlin 1))
(movei tt termlin)
(calli tt #o400047)
(jrst 0 false)
(jrst 0 true)
(entry em:copy-alias1 subr)
(args em:copy-alias1 (nil . 0))
(move tt (special si:ejobnum))
(calli tt #o400071) ;dskppn
(calli tt #o400071)
(push fxp tt)
(hrlzs 0 tt)
(pushj p sixatm)
(jsp t %ncons)
(push p a)
(pop fxp tt)
(hllzs 0 tt)
(pushj p sixatm)
(pop p b)
(jsp t %cons)
(popj p)
;;; Send OK
send-ok
(movei a ok-type)
(movem a (+ o2mailbox 1))
(move b thisjob)
(hrli b epr)
(movem b o2mailbox)
(jfcl)
(mail 5 o2jobnum)
(jsp tt wait-for-clear)
(jrst 0 true)
(jrst 0 false)
;;; Em:eval-protect
(entry em:eval-protect subr)
(args em:eval-protect (nil . 0))
(movei a 'em:sail-mail-interrupt-handler)
(movem a (special si:sail-mail-service))
(movei a 't)
(popj p)
(entry em:eval-unprotect subr)
(args em:eval-unprotect (nil . 0))
(movei a 'nil)
(movem a (special si:sail-mail-service))
(popj p)
(entry em:critical-depth subr)
(args em:critical-depth (nil . 0))
(move tt critical)
(jrst 0 fix1)
;;; Mail queue
(entry em:business-address subr)
(args em:business-address (nil . 1))
(hrrz a 0 a) ;get address
(hrrz tt 0 a)
(hrrzi tt 4 tt) ;business address
(jrst 0 fix1) ;return it
(entry em:message-type subr)
(args em:message-type (nil . 1))
(hrrz a 0 a) ;get address
(hrrz tt 0 a)
(hrrz tt 5 tt) ;business address
(move a types tt)
(popj p) ;return it
(entry em:mail-interrupt-handler subr)
(args em:mail-interrupt-handler (nil . 1))
(aos 0 critical)
(722←33 0 mailint) ;imskcl
; (mail 3)
; (jrst 0 uncriticalfalse)
(push fxp tt)
(push fxp t)
(push fxp d)
mi4 (call 0 'em:add-queue)
(hrrz tt 0 a) ;address of mailbox
mi5 (mail 1 0 tt) ;get mail
(push fxp tt)
(move tt 0 tt)
(jsp t validate-mail)
(jrst 0 mi6)
(pop fxp tt)
(move t 1 tt) ;type bits
(cain t interrupt-type)
(jrst 0 mi8)
(cain t kill-type)
(calli 1 12) ;suicide
(push fxp t)
; (setzm 0 lqp)
(tlnn t short-bit) ;short?
(pushj p enqueue-buffer)
(pop fxp t)
(setzm 0 contp)
(tlze t cont-bit)
(jrst 0 mi7)
; (setom 0 lqp)
(jrst 0 mi8)
mi6 (pop fxp tt)
(jrst 0 mi5)
mi7 (setom 0 contp)
(movem t 1 tt)
(jrst 0 mi4)
mi8 (hrrz d 1 tt) ;type
(sosg 0 critical)
(721←33 0 mailint) ;imskst
procint
(cain d kill-type)
(calli 1 12) ;suicide
(caie d interrupt-type) ;control char?
(jrst 0 mitrue) ;no, just report the incident
(trne d meta-bit)
(jrst 0 mitrue)
(sub fxp (% 0 0 3 3)) ;baz pop those guys
(push fxp tt)
(call 0 'em:remove-tail)
(skipe 0 withinrov)
(pushj p rovuninit)
(pop fxp tt)
(move tt 2 tt)
(tro tt #o200) ;controlify it
(hlrz t noquit) ;Maclisp bug allowed this interrupt
(jumpn t mitr1)
(jsp t fxcons)
(jcall 1 'em:control-dispatch)
mitr1 (pushj p em:defer-interrupt)
(jrst 0 true)
mitrue
(pop fxp d)
(pop fxp t)
(pop fxp tt)
(jrst 0 true)
uncriticalfalse
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(jrst 0 false)
;;; Readonly Variables
;;; Routines for obtaining the values of readonly variables
(entry em:readonly-init subr)
(args em:readonly-init (nil . 0))
(aos 0 critical)
(722←33 0 mailint) ;imskcl
;inited mailinp
;0 0 ?
;0 -1 in but not inited, must refresh
;-1 0 ok
;-1 -1 contradiction
(pushj p gobble-stuff) ;all clear
(setom 0 withinrov)
(move tt tyop)
(movem tt otyop)
; (move tt tyi-inited)
; (movem tt otyi-inited)
(move tt transfer-spot)
(movem tt otransfer-spot)
(move tt transfer-size)
(movem tt otransfer-size)
(setzm 0 tyop)
(jrst 0 true)
(entry em:make-sixbit subr)
(args em:make-sixbit (nil . 1))
;;; Takes list of variables and returns an alist of variable-value pairs
sixmak (movei b '6) ;direct lift from faslap
(call 2 'pnget)
(hlrz a 0 a)
(move tt 0 a)
(idpb tt rovpoint) ;put it there
(sosle 0 rovbytes) ;ready to send?
(jrst 0 fix1) ;return fixnum
;falls through
;;; Read only variable mail message
(entry em:force-readonly-message subr)
(args em:force-readonly-message (nil . 0))
em:force-readonly-message
; (setzm 0 tyi-inited)
(movei a rovmail) ;address of buffer
(movem a (+ omailbox 2))
(movei a nrovbytes)
(sub a rovbytes)
(movei t 1) ;1 in t means long
(caile a rovmaxshort) ;short enough
(jrst 0 rovsend-message) ;nope
(setz t) ;0 in T means short
(hrlzi tt rovmail)
(hrri tt (+ omailbox 3))
(blt tt (+ omailbox (- mlblksize 1))) ;move to the right place
(iori b short-bit)
rovsend-message
(hrl tt b) ;swap
(hrri tt readonlyvar-type)
(movem tt (+ omailbox 1))
(movns 0 a)
(hrlzm a (+ omailbox 2))
(movei a rovmail)
(hrrm a (+ omailbox 2))
(move a thisjob)
(hrli a epr) ;epr validation
(movem a omailbox)
(mail 3)
(mail 5 ojobnum) ;mail it
(jsp tt wait-for-clear)
(skipa)
(jrst 0 wrongj)
(hrlzi a rovmail) ;zeros output buffer
(hrri a (+ rovmail 1))
(setzm 0 rovmail)
(blt a (+ rovmail (- rovmailblksize 1))) ;zero it
(move a rovpointtem) ;setup output byte count
(movem a rovpoint)
(movei a 1)
(movem a rinbytes)
(movei a nrovbytes)
(movem a rovbytes)
(jumpe t true) ;don't hang around
(pushj p wait-ok) ;wait for acknowledgment
(pushj p em:mail-type)
(came a 'ok)
(jrst 0 false)
(jrst 0 true)
(entry em:get-next-readonly subr)
(args em:get-next-readonly (nil . 0))
; (skipn 0 tyi-inited)
(skiple 0 rinbytes)
(pushj p rovmail-refresh)
(aosle 0 rinbytes)
(jrst 0 rovdone)
(ildb tt irovpoint) ;get it
(jsp t fxcons)
(push fxp a) ;save it
(aosle 0 rinbytes)
(jrst 0 (- rovdone 1))
(ildb tt irovpoint)
(jsp t fxcons)
(pop fxp b)
(jcall 2 'xcons)
(sub fxp (% 0 0 1 1))
rovdone
; (move tt otyi-inited)
; (movem tt tyi-inited)
(pushj p rovuninit)
(seto tt)
(jrst 0 fix1)
rovuninit
(move tt otransfer-spot)
(movem tt transfer-spot)
(move tt otransfer-size)
(movem tt transfer-size)
(move tt otyop)
(movem tt tyop)
(setzm 0 withinrov)
(sosg 0 critical)
(721←33 0 mailint) ;imskst
(popj p)
rovmail-refresh
rm2 (pushj p em:wait-mail)
(pushj p em:process-mail)
(cain a 'readonlyvars)
(popj p)
(jrst 0 rm2)
;;; Random debugging stuff
;;; Prints the char on FXP with outchr
;pushtt1
; (push fxp tt)
; (movei tt 101)
; (ttyuuo 1 tt)
; (aos 0 ptt1)
; (move tt 0 fxp)
; (popj p)
;poptt1
; (movei tt 141)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt1)
; (popj p)
;pushtt2
; (push fxp tt)
; (movei tt 102)
; (ttyuuo 1 tt)
; (aos 0 ptt2)
; (move tt 0 fxp)
; (popj p)
;poptt2
; (movei tt 142)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt2)
; (popj p)
;pushtt3
; (push fxp tt)
; (movei tt 103)
; (ttyuuo 1 tt)
; (aos 0 ptt3)
; (move tt 0 fxp)
; (popj p)
;poptt3
; (movei tt 143)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt3)
; (popj p)
;pushtt4
; (push fxp tt)
; (movei tt 104)
; (ttyuuo 1 tt)
; (aos 0 ptt4)
; (move tt 0 fxp)
; (popj p)
;poptt4
; (movei tt 144)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt4)
; (popj p)
;pushtt5
; (push fxp tt)
; (movei tt 105)
; (ttyuuo 1 tt)
; (aos 0 ptt5)
; (move tt 0 fxp)
; (popj p)
;poptt5
; (movei tt 145)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt5)
; (popj p)
;pushtt6
; (push fxp tt)
; (movei tt 106)
; (ttyuuo 1 tt)
; (aos 0 ptt6)
; (move tt 0 fxp)
; (popj p)
;poptt6
; (movei tt 146)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt6)
; (popj p)
;pushtt7
; (push fxp tt)
; (movei tt 107)
; (ttyuuo 1 tt)
; (aos 0 ptt7)
; (move tt 0 fxp)
; (popj p)
;poptt7
; (movei tt 147)
; (ttyuuo 1 tt)
; (pop fxp tt)
; (sos 0 ptt7)
; (popj p)
;popt
; (movei t 22)
; (ttyuuo 1 t)
; (pop fxp t)
; (sos 0 pt)
; (popj p)
;ptt1 (0)
;ptt2 (0)
;ptt3 (0)
;ptt4 (0)
;ptt5 (0)
;ptt6 (0)
;ptt7 (0)
;pt (0)
;;report
; (movem tt sav)
; (pop fxp tt)
; (ttyuuo 1 tt)
; (move tt sav)
; (popj p)
sav (0)
;;; Storage for Mail routines
types (0 0 'no-op)
(0 0 'initiate)
(0 0 'ok)
(0 0 'sexps)
(0 0 'explicit-eof)
(0 0 'e-command)
(0 0 'interrupt)
(0 0 'kill)
(0 0 'readonlyvars)
chnint (0)
intpdl (0)
critical (0)
delayedsexp (0) ;states whether an sexpr came in during
;an input buffer dry demon execution
newwrcv (0) ;is not 0 when a WRCV has been done without any
;ilbp being done (sexps only)
lqp (0) ;queued long mail read
contp (0) ;continuation bit
withinrov (0)
transfer-spot (0)
otransfer-spot (0)
transfer-size (0)
otransfer-size (0)
svdacs (block 10.)
send-lines (0)
noncrlf (0)
vsend-lines (0)
skipp (0)
tyop (0)
otyop (0)
forcedp (0) ;output already forced
inwords (0) ;number of words to input via jobread
explicit-eof (-1) ;nil
mailint (4000000000)
ijobnum (-1)
(0 0 imailbox)
ojobnum (-1)
(0 0 omailbox)
o2jobnum(-1)
(0 0 o2mailbox)
imailbox (block mlblksize) ;mail
omailbox (block mlblksize) ;mail
o2mailbox (block mlblksize) ;mail
inmail (block blksize) ;text
outmail (block blksize) ;text
rovmail (block rovmailblksize)
stack (block 20)
untyipdl (777760←22 0 stack)
temuntyipdl (777760←22 0 stack)
untyif (0)
jobrderr (0)
jobrderrdispatch (0 0 jobrdem1)
(0 0 jobrdem2)
(0 0 jobrdem3)
(0 0 jobrdem4)
(0 0 jobrdem5)
(0 0 jobrdem6)
jobrdem1 (ascii | job not logged in|)(0)
jobrdem2 (ascii | ambiguous job name|)(0)
jobrdem3 (ascii | non-ex job name|)(0)
jobrdem4 (ascii | addr out of bounds|)(0)
jobrdem5 (ascii | job not logged in|)(0)
jobrdem6 (ascii | block too large|)(0)
jobrdmess1
(ascii |Communication Failed! (Transfer Buffer)|)
(0)
jobrdmess2
(ascii |Communication Failed! (Interrupt Level)|)
(0)
noquitmess (ascii |Interrupt during GC!|)
(0)
termlin (0)
(0 0 dmess)
dmess (block 100.)
(0)
mpointtem (700←22 0 (- dmess 1))
inpoint (1100←22 0 (- inmail 1))
inpointtem (1100←22 0 (- inmail 1))
irovpoint (4400←22 0 (- rovmail 1))
irovpointtem (4400←22 0 (- rovmail 1))
rinbytes (1)
inbytes (0)
outpoint (700←22 0 (- outmail 1))
outpointtem (700←22 0 (- outmail 1))
rovpoint (4400←22 0 (- rovmail 1))
rovpointtem (4400←22 0 (- rovmail 1))
outchartem (700←22 0 (+ omailbox 2))
outbytes (0 0 noutbytes)
rovbytes (0 0 nrovbytes)
;mailinp (0) ;-1 means in (newwrcv and this go on the same time, newwrcv goes
; off earlier)
mthree (-3)
charpos (0)
thisjob (0)
;tyi-inited (0) ;ready to read. 0 = nil, -1 = t (meaning buffer pointers inited)
;otyi-inited (0) ;ready to read. 0 = nil, -1 = t
eofchar (0) ;eof char
jobread (0)
(0)
(0 0 inmail)
ljobread(0)
(0)
(0 0 inmail)
()
(or (and (boundp 'em:no-init) em:no-init)
(progn
(em:mail-interface-initialize)))